home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / rotate1a / rotatesq.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-09-10  |  5.6 KB  |  165 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BackColor       =   &H80000007&
  4.    Caption         =   "RotateSquare 
  5.  oigres P"
  6.    ClientHeight    =   3195
  7.    ClientLeft      =   60
  8.    ClientTop       =   345
  9.    ClientWidth     =   4680
  10.    ClipControls    =   0   'False
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   213
  13.    ScaleMode       =   3  'Pixel
  14.    ScaleWidth      =   312
  15.    StartUpPosition =   3  'Windows Default
  16.    Begin VB.Timer Timer1 
  17.       Interval        =   10
  18.       Left            =   360
  19.       Top             =   1920
  20.    End
  21.    Begin VB.Line Line1 
  22.       BorderColor     =   &H00C0FFFF&
  23.       BorderWidth     =   5
  24.       Index           =   3
  25.       X1              =   192
  26.       X2              =   72
  27.       Y1              =   48
  28.       Y2              =   72
  29.    End
  30.    Begin VB.Line Line1 
  31.       BorderColor     =   &H00FF0000&
  32.       BorderWidth     =   5
  33.       Index           =   2
  34.       X1              =   152
  35.       X2              =   80
  36.       Y1              =   160
  37.       Y2              =   80
  38.    End
  39.    Begin VB.Line Line1 
  40.       BorderColor     =   &H0000FF00&
  41.       BorderWidth     =   5
  42.       Index           =   1
  43.       X1              =   248
  44.       X2              =   144
  45.       Y1              =   136
  46.       Y2              =   160
  47.    End
  48.    Begin VB.Line Line1 
  49.       BorderColor     =   &H000000FF&
  50.       BorderWidth     =   5
  51.       Index           =   0
  52.       X1              =   192
  53.       X2              =   248
  54.       Y1              =   48
  55.       Y2              =   128
  56.    End
  57. Attribute VB_Name = "Form1"
  58. Attribute VB_GlobalNameSpace = False
  59. Attribute VB_Creatable = False
  60. Attribute VB_PredeclaredId = True
  61. Attribute VB_Exposed = False
  62. 'RotateRectangle 
  63.  oigres P
  64. 'Email: oigres@postmaster.co.uk
  65. 'indented by indenter5 from www.BMSLtd.co.uk
  66. Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
  67. Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  68. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  69. Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
  70. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  71. Private Const ALTERNATE = 1
  72. Private Const WINDING = 2
  73. Private Const RGN_AND = 1
  74. Private Const RGN_COPY = 5
  75. Private Const RGN_DIFF = 4
  76. Private Const RGN_OR = 2
  77. Private Const RGN_XOR = 3
  78. Dim x, y
  79. Private Type pt
  80.     X1 As Variant
  81.     Y1 As Variant
  82.     X2 As Variant
  83.     Y2 As Variant
  84.     X3 As Variant
  85.     Y3 As Variant
  86.     X4 As Variant
  87.     Y4 As Variant
  88. End Type
  89. Private Type POINTAPI
  90.     x As Long
  91.     y As Long
  92. End Type
  93. 'Dim ptarray(3) As pt
  94. 'Dim store(3) As pt
  95. Dim prgn(3) As POINTAPI 'rgn array
  96. Dim temp, hrgn1, hrgn2, hrgn3 As Long 'handles to rgns
  97. Private Sub Form_KeyPress(KeyAscii As Integer)
  98.     'return to exit program
  99.     If KeyAscii = 13 Then End
  100. End Sub
  101. Private Sub sqlines()
  102.     Static degree, radians
  103.     Static add
  104.     Static radius
  105.     'algorithm: get a point in a circle and offset 3
  106.     'other points by 90 degrees
  107.     'radians = (degree / 180) * 3.14
  108.     'radius of circle
  109.     If radius > 100 Then add = -2
  110.     If radius < 5 Then add = 2
  111.     radius = radius + add
  112.     degree = IIf(degree < 360, degree + 2, 0)
  113.     degrad = (degree / 180) * 3.14 'radian convertion
  114.     Index = 0
  115.     degrad2 = 0
  116.     cntrfx = Form1.ScaleWidth \ 2
  117.     cntrfy = Form1.ScaleHeight \ 2
  118.     'clockwise rotation; setup first point of sqr
  119.     x = radius * Cos(degrad + degrad2) + radius * Sin(degrad + degrad2) + cntrfx
  120.     y = radius * Sin(degrad + degrad2) - radius * Cos(degrad + degrad2) + cntrfy
  121.     Line1(Index).X1 = x - 2 '        line shape for effect
  122.     Line1(Index).Y1 = y - 25
  123.     stx = x: sty = y 'store start x ,y
  124.     prgn(Index).x = x: prgn(Index).y = y 'array for rgn
  125.     'CurrentX = x: CurrentY = y
  126.     For offset = 90 To 270 Step 90 ' 90,180,270 corner offsets
  127.         degrad2 = (offset / 180) * 3.14 'offset to radians
  128.         x = radius * Cos(degrad + degrad2) + radius * Sin(degrad + degrad2) + cntrfx
  129.         y = radius * Sin(degrad + degrad2) - radius * Cos(degrad + degrad2) + cntrfy
  130.         Line1(Index).X2 = x - 2 '
  131.         Line1(Index).Y2 = y - 25
  132.         prgn(Index).x = x: prgn(Index).y = y
  133.         'Form1.Line -(x, y), &HFFFFFF
  134.         'Line1(Index).X1 = x
  135.         'Line1(Index).Y1 = y
  136.         Index = Index + 1
  137.         '
  138.         Line1(Index).X1 = x - 2
  139.         Line1(Index).Y1 = y - 25
  140.         'Debug.Print Index
  141.     Next offset
  142.     prgn(3).x = stx: prgn(3).y = sty
  143.     Line1(Index).X2 = stx - 2
  144.     Line1(Index).Y2 = sty - 25
  145.     'Form1.Line -(stx, sty)
  146.     'erase window rgn , set to 0 to make the system discard ownership
  147.     'Hint from p430 of Delphi2 developers guide by Xavier Pacheco and Steve Teixeira
  148.     success = SetWindowRgn(Form1.hWnd, 0&, True)
  149.     If hrgn1 <> 0 Then
  150.         success = DeleteObject(hrgn1)
  151.         success = DeleteObject(hrgn2)
  152.         success = DeleteObject(hrgn3)
  153.     End If
  154.     hrgn1 = CreatePolygonRgn(prgn(0), 4, WINDING) 'rotating square
  155.     hrgn2 = CreateRectRgn(0, 0, Form1.ScaleWidth + 10, Form1.ScaleHeight + 40)
  156.     '               cut out square out of big window rgn
  157.     hrgn3 = CombineRgn(hrgn1, hrgn1, hrgn2, RGN_XOR)
  158.     success = SetWindowRgn(Form1.hWnd, hrgn1, True) 'set new rgn to form
  159.     DoEvents
  160.     'Wend
  161. End Sub
  162. Private Sub Timer1_Timer()
  163.     sqlines
  164. End Sub
  165.